home *** CD-ROM | disk | FTP | other *** search
/ Atari Forever 4 / Atari Forever 4.zip / Atari Forever 4.iso / PD_THEMA / BIORHYTM / BIORYTHM / BIORHYT.BAS < prev    next >
BASIC Source File  |  1998-03-14  |  18KB  |  506 lines
  1. 10    '*********************************************************
  2. 20    '* BIORHYTMUS ST.   von Wolfgang Wenk                    *
  3. 21    '* Hauptstr.22,2167 Himmelpforten, [04144/8678]          *
  4. 22    '* ----------> kopieren erlaubt <----------------------- *
  5. 29    '* INPUTFORM von M.Vagts, Stade                          *
  6. 30    '*********************************************************
  7. 31    '------------------------------------> init
  8. 35    clearw 2:fullw 2
  9. 40    pi =-2* 3.14159:r=8
  10. 50    dim monattage%(13), tagesname$(7)
  11. 60    for i = 1 to 13
  12. 70    read monattage%(i)
  13. 80    next
  14. 90    '
  15. 140   for i = 1 to 7
  16. 150   read tagesname$(i)
  17. 160   next
  18. 170   '
  19. 190   '---------------------------------> titelbild
  20. 200   dim xkoord(100),ykoord(100)
  21. 210   '
  22. 250   '
  23. 260   gosub INIT
  24. 270   gosub CLEARDESK
  25. 280   gosub FULLWIND
  26. 290   color 1,1,1,2,2
  27. 300   xpos1=0  :ypos1=-15:xpos2=640:ypos2=-38
  28. 310   gosub RECHTECK
  29. 320   text$=chr$(14)+chr$(15)+" BIORHYTHMUS "+chr$(14)+chr$(15)
  30. 330   xpos=230:ypos=-20:gosub TEXTAUSGABE
  31. 331   clearw 2
  32. 335   anfangsform=0:endform=1
  33. 336   gosub LINIENENDFORM
  34. 337   linef 200,150,450,150
  35. 340   xpos1=130:ypos1=15:xpos2=500:ypos2=250:fuell=0
  36. 350   gosub RECHTECKRUND
  37. 360   xpos1=132:ypos1=17:xpos2=502:ypos2=252:fuell=0
  38. 370   gosub RECHTECKRUND
  39. 380   groesse=18:gosub schriftgroesse
  40. 390   text$=chr$(14)+chr$(15)+" BIORHYTHMUS "+chr$(14)+chr$(15)
  41. 400   xpos=175:ypos=45
  42. 410   gosub textausgabe
  43. 420   groesse=9:gosub schriftgroesse
  44. 430   text$=chr$(189)+" W.Wenk 1986 "
  45. 440   xpos=260:ypos=55
  46. 450   gosub textausgabe
  47. 460   anzahl=30
  48. 470   for i = 0 to anzahl
  49. 480   xkoord(i)=230+i*200/anzahl
  50. 490   ykoord(i)= 80+rnd(1)*100
  51. 500   next
  52. 510   gosub POLYLINE
  53. 520   text$="Erklärung [J]"
  54. 530   xpos=148:ypos=230
  55. 540   gosub textausgabe
  56. 550   text$="oder kann ich mir das sparen ? [RETURN]"
  57. 560   xpos=148:ypos=240
  58. 570   gosub textausgabe
  59. 580   gosub normtext
  60. 590   out 2,7:a$=chr$(inp(2))
  61. 600   if asc(a$)=13 then goto DIAGRAMM
  62. 610   if asc(a$)=106 then goto INFO
  63. 620   if asc(a$)<> 13 or asc(a$)<>106 then 590
  64. 621   '
  65. 622   '---------------------------------> eingabe
  66. 623   '
  67. 630   DIAGRAMM:
  68. 640   clearw 2
  69. 650   groesse=19:gosub schriftgroesse
  70. 660   schrifttyp=1:gosub schriftart
  71. 670   text$="Klasse, ":xpos=50:ypos=40
  72. 680   gosub textausgabe
  73. 690   gosub normtext
  74. 700   text$="...dann können wir ja loslegen:"
  75. 710   xpos=150:ypos=40:gosub textausgabe
  76. 720   color 1,1,1,1,1
  77. 730   xpos1=40:ypos1=45:xpos2=560:ypos2=80
  78. 740   gosub RECHTECK
  79. 750   color 1,1,0,0,0
  80. 760   xpos1=40:ypos1=81:xpos2=560:ypos2=350
  81. 770   gosub RECHTECK
  82. 780   text$=" Meine Fragen:":xpos=50:ypos=68
  83. 790   gosub textausgabe
  84. 800   text$=" Deine Antworten:":xpos=400:ypos=68
  85. 810   gosub textausgabe
  86. 820   out 2,7:text$="Dein Name:":xpos=45:ypos=100
  87. 825   gosub textausgabe
  88. 830   xpos=420:ypos=100:laenge=10:modus=3:groesse=10:gosub INPUTFORM
  89. 835   name$=key$
  90. 850   '
  91. 860   out 2,7:text$="..und Dein Geburtsdatum "+name$
  92. 870   xpos=45 :ypos=120:gosub textausgabe
  93. 875   xpos=45:ypos=138:text$="[z.B. 1.Aug.1960 = 01081960]":gosub textausgabe
  94. 878   xpos=420:ypos=138:text$="       ":gosub textausgabe
  95. 880   xpos=420:ypos=138:laenge=8 :modus=1:groesse=10:gosub INPUTFORM
  96. 885   gebdat$=key$
  97. 887   if len(gebdat$)<8 then goto 10000
  98. 888   if (val(mid$(gebdat$,3,2))>12) or(val(left$(gebdat$,2))>31) then goto 10000
  99. 890   if (val(mid$(gebdat$,3,2))<=0) or (val(left$(gebdat$,2))<=0) then goto 10000
  100. 891   '
  101. 892   '---------------------------------> wochentag der geburt
  102. 893   '
  103. 900   gebtag=val(left$(gebdat$,2))
  104. 910   gebmon=val(mid$(gebdat$,3,2))
  105. 920   gebjah=val(right$(gebdat$,4))
  106. 930   gebmon=int(gebmon)
  107. 940   gebtag=int(gebtag)
  108. 950   gebjah=int(gebjah)
  109. 960   tageab =int(gebtag+365.25 * gebjah+monattage% (gebmon) +.01 * gebmon - .03)
  110. 970   k=int(.6+(1/gebmon))
  111. 980   l=gebjah-k
  112. 990   o= gebmon + 12 * k
  113. 1000  p= l/100
  114. 1010  z1= int(p/4)
  115. 1020  z2= int (p)
  116. 1030  z3= int((5*l)/4)
  117. 1040  z4= int(13*(o+1)/5)
  118. 1050  z = z4 + z3 - z2 + z1 + gebtag - 1
  119. 1060  z = (z-(7*int(z/7)))+1
  120. 1080  out 2,7:text$="Für welchen Monat soll ich die Kurve berechnen? "
  121. 1090  xpos=45:ypos=180:gosub textausgabe
  122. 1100  text$="[z.B. MAI 1986 = 051986]"
  123. 1110  xpos=45:ypos=200:gosub textausgabe
  124. 1115  xpos=420:ypos=200:text$="        ":gosub textausgabe
  125. 1120  xpos=420:ypos=200:laenge=6 :modus=1:groesse=10:gosub INPUTFORM
  126. 1125  start$ ="01"+ key$
  127. 1126  if len(start$)<8 then goto 11010
  128. 1128  if (val(mid$(start$,3,2))>12) then goto 11010
  129. 1129  '
  130. 1130  '---------------------------------> gesamttage berechnen
  131. 1135  '
  132. 1140  bistag=val(left$(start$,2))
  133. 1150  bismon=val(mid$(start$,3,2))
  134. 1160  bisjah=val(right$(start$,4))
  135. 1170  bismon=int(bismon)
  136. 1180  bistag=int(bistag)
  137. 1190  bisjah=int(bisjah)
  138. 1200  tagebis=int(bistag+365.25 * bisjah+monattage%(bismon) +.01 * bismon - .03)
  139. 1210  altertage= tagebis - tageab
  140. 1230  xalt=55:yalt=220:breit1=40:hoch1=40
  141. 1240  xneu=55 :yneu=250:breit2=300:hoch2=100
  142. 1250  color 1,1,0,0,0
  143. 1270  xpos1=55 :ypos1=230:xpos2=540:ypos2=340
  144. 1280  gosub GROWBOX:gosub RECHTECK
  145. 1290  schrifttyp=16:gosub schriftart
  146. 1300  groesse=10:gosub schriftgroesse
  147. 1310  text$="Das erste Zwischenergebnis:
  148. 1320  xpos=53 :ypos=223:gosub textausgabe
  149. 1330  schrifttyp=17:gosub schriftart
  150. 1340  groesse= 9:gosub schriftgroesse
  151. 1350  text$="Du warst am Letzten des Vormonats"+str$(altertage)+" Tage"
  152. 1360  xpos=70 :ypos=260:gosub textausgabe
  153. 1370  text$="alt und bist an einem "+tagesname$(z)+" geboren !"
  154. 1380  xpos=70 :ypos=272:gosub textausgabe
  155. 1390  schrifttyp= 1:gosub schriftart
  156. 1400  text$="-----------------------------------------------------"
  157. 1410  xpos=70:ypos=290:gosub textausgabe
  158. 1420  text$="Wenn Du Dich über dieses Ergebnis genug gefreut hast,"
  159. 1430  xpos=70 :ypos=310:gosub textausgabe
  160. 1440  text$="drücke bitte eine Taste, damit's weitergeht !!"
  161. 1450  xpos=70 :ypos=319:gosub textausgabe
  162. 1460  out 2,7:  warte=inp(2)
  163. 1470  gosub SCHRUMPFBOX
  164. 1480  gosub normtext
  165. 1489  '
  166. 1490  '---------------------------------> berechnen kurvenfaktor
  167. 1491  '
  168. 1500  ps=23*(altertage/23-int(altertage/23)):'----> koerper (physisch)
  169. 1510  es=28*(altertage/28-int(altertage/28)):'----> gefuehl (emotion)
  170. 1520  is=33*(altertage/33-int(altertage/33)):'----> geist   (intellekt)
  171. 1521  '---------------------------------> bildschirm
  172. 1530  clearw 2
  173. 1540  xalt=8:yalt=150:breit1=140:hoch1=140
  174. 1550  xneu=8  :yneu=150:breit2=590:hoch2=150
  175. 1560  xpos1=8:ypos1=1:xpos2=590:ypos2=150
  176. 1570  color 1,1,1,1,2
  177. 1580  gosub GROWBOX:gosub RECHTECK
  178. 1581  xalt=8:yalt=570:breit1=140:hoch1=140
  179. 1582  xneu=158:yneu=350:breit2=590:hoch2=150
  180. 1590  xpos1=8:ypos1=150:xpos2=590:ypos2=300
  181. 1600  gosub GROWBOX:gosub RECHTECK
  182. 1610  groesse= 9:gosub schriftgroesse
  183. 1620  modus=1:gosub GRAFIKMODUS
  184. 1630  text$="1       5         10          15          20        25        30     34"
  185. 1640  xpos=12:ypos=295:gosub textausgabe
  186. 1645  modus=1:gosub GRAFIKMODUS
  187. 1650  '
  188. 1660  schrifttyp=16:gosub schriftart
  189. 1670  groesse=10:gosub schriftgroesse
  190. 1680  text$="für "+name$
  191. 1690  xpos=10:ypos=-3 :gosub textausgabe
  192. 1700  text$="* "+left$(gebdat$,2)+"."+mid$(gebdat$,3,2)+"."+right$(gebdat$,4)
  193. 1710  xpos=470:ypos=-3 :gosub textausgabe
  194. 1720  groesse=19:gosub schriftgroesse
  195. 1730  text$="+":xpos=600:ypos=90 :gosub textausgabe
  196. 1740  text$="-":xpos=600:ypos=210:gosub textausgabe
  197. 1750  gosub normtext
  198. 1760  schrifttyp=8:gosub schriftart
  199. 1770  text$="Es bedeutet:":xpos=10 :ypos=320:gosub textausgabe
  200. 1780  gosub normtext
  201. 1790  text$=" * = physisch/Körper":xpos=105:ypos=320:gosub textausgabe
  202. 1800  text$=" + = Emotion/Gefühl ":xpos=105:ypos=335:gosub textausgabe
  203. 1810  text$=" - = Intellekt/Geist":xpos=105:ypos=350:gosub textausgabe
  204. 1820  groesse=19:gosub schriftgroesse
  205. 1830  schrifttyp=16:gosub schriftart
  206. 1840  text$=str$(bismon)+"/"+str$(bisjah)
  207. 1850  xpos=330:ypos=320:gosub textausgabe
  208. 1860  gosub normtext
  209. 1870  groesse=9:gosub schriftgroesse
  210. 1880  text$="[RETURN] = neuer Monat "
  211. 1890  xpos=330:ypos=335:gosub textausgabe
  212. 1900  text$="[SPACE]  = neue Daten"
  213. 1910  xpos=330:ypos=344:gosub textausgabe
  214. 1920  text$=" * = FEIERABEND !!"
  215. 1930  xpos=335:ypos=353:gosub textausgabe
  216. 1940  gosub normtext
  217. 1950  modus=2:gosub GRAFIKMODUS
  218. 1960  '---------------------------------> physisch
  219. 1970  for kurve = 1 to 34
  220. 1980  p=r+r*sin((ps+kurve)*pi/23)+1.5
  221. 1990  gotoxy kurve,p:print "*"
  222. 2000  next
  223. 2020  '---------------------------------> emotion
  224. 2030  for kurve1= 1 to 34
  225. 2040  e=r+r*sin((es+kurve1)*pi/28)+1.5
  226. 2050  gotoxy kurve1,e:print "+"
  227. 2060  next
  228. 2080  '---------------------------------> intellekt
  229. 2090  for kurve2= 1 to 34
  230. 2100  i=r+r*sin((is+kurve2)*pi/33)+1.5
  231. 2110  gotoxy kurve2,i:print "-"
  232. 2120  next
  233. 2130  '
  234. 2140  modus=1:gosub GRAFIKMODUS
  235. 2150  out 2,7:a$=chr$(inp(2))
  236. 2160  if asc(a$)=13 then goto WEITER
  237. 2170  if asc(a$)=32 then goto DIAGRAMM
  238. 2180  if asc(a$)=42 then goto ENDE
  239. 2181  '
  240. 2182  '---------------------------------> ende
  241. 2183  '
  242. 2190  ENDE:
  243. 2200  clearw 2
  244. 2201  color 1,1,0,0,0
  245. 2202  xpos1=110:ypos1=80:xpos2=440:ypos2=220
  246. 2203  gosub RECHTECK
  247. 2204  xpos1=112:ypos1=82:xpos2=446:ypos2=226:gosub RECHTECK
  248. 2205  color 1,1,1,1,1
  249. 2208  xpos1=130:ypos1=100:xpos2=420:ypos2=200
  250. 2209  gosub RECHTECK
  251. 2210  color 1,1,1,9,2
  252. 2212  xpos=133:ypos=148:xpos2=423:ypos2=205
  253. 2215  gosub RECHTECK
  254. 2219  groesse=19:gosub schriftgroesse
  255. 2220  schrifttyp=1 :gosub schriftart
  256. 2230  text$=" T s c h ü ß "
  257. 2240  xpos=160:ypos=150:gosub textausgabe
  258. 2250  out 2,7:
  259. 2260  gosub normtext
  260. 2270  warte=inp(2)
  261. 2280  end
  262. 2281  '
  263. 2282  '---------------------------------> info
  264. 2283  '
  265. 2290  INFO:
  266. 2300  clearw 2:gotoxy 0,0
  267. 2310  schrifttyp=24:gosub schriftart
  268. 2320  xpos=150:ypos=20:text$=" Was ist der BIORHYTHMUS ?? "
  269. 2330  gosub textausgabe
  270. 2340  gosub normtext
  271. 2350  schrifttyp=4:gosub schriftart
  272. 2360  text$="BIORHYTHMUS hat nichts mit Tanzen zu tun,wie Du vielleicht denkst."
  273. 2370  xpos=50 :ypos=40:gosub textausgabe
  274. 2380  text$="Schon die alten Griechen glaubten, daß das Leben in bestimmten   "
  275. 2390  xpos=50 :ypos=55 :gosub textausgabe
  276. 2400  text$="Zyklen abläuft. Die Zyklen beginnen bei der Geburt als Sinuskurve"
  277. 2410  xpos=50 :ypos=70 :gosub textausgabe
  278. 2420  text$="zu laufen:"
  279. 2430  xpos=50 :ypos=85 :gosub textausgabe
  280. 2440  text$="1. Der PHYSISCHE     Zyklus = 23 Tage  ( * )"
  281. 2450  xpos=100:ypos=115:gosub textausgabe
  282. 2460  text$="2. Der EMOTIONALE    Zyklus = 28 Tage  ( + )"
  283. 2470  xpos=100:ypos=130:gosub textausgabe
  284. 2480  text$="3. Der INTELEKTUELLE Zyklus = 33 Tage  ( - )"
  285. 2490  xpos=100:ypos=145:gosub textausgabe
  286. 2500  text$="Kritisch sind immer nur die Tage, an denen sich die Kurve mit der"
  287. 2510  xpos=50 :ypos=175:gosub textausgabe
  288. 2520  text$="Mittelachse kreuzt. Viele Leute glauben daran, daß man an diesen "
  289. 2530  xpos=50 :ypos=190:gosub textausgabe
  290. 2540  text$="Tagen häufiger Fehler macht, Unfälle passieren oder man körperlich"
  291. 2550  xpos=50 :ypos=205:gosub textausgabe
  292. 2560  text$="anfälliger ist. Sollte sich für Dich ergeben, daß heute ein      "
  293. 2570  xpos=50 :ypos=220:gosub textausgabe
  294. 2580  text$="kritischer Tag ist, und Du machst keinen Fehler, Dir fällt kein  "
  295. 2590  xpos=50 :ypos=235:gosub textausgabe
  296. 2600  text$="Ziegelstein auf den Kopf oder Du hast keinen Nervenzusammenbruch,"
  297. 2610  xpos=50 :ypos=250:gosub textausgabe
  298. 2620  text$="mach' mich bitte nicht dafür verantwortlich!"
  299. 2630  xpos=50 :ypos=265:gosub textausgabe
  300. 2640  text$="Die Kurve zeichne ich übrigens für 34 Tage ab 1. des jew.Monats !"
  301. 2650  xpos=50 :ypos=280:gosub textausgabe
  302. 2660  groesse=19:gosub schriftgroesse
  303. 2670  schrifttyp=16:gosub schriftart
  304. 2680  text$="Alles klar ???? "
  305. 2690  xpos=150:ypos=330:gosub textausgabe
  306. 2700  groesse=9:gosub schriftgroesse
  307. 2710  schrifttyp=0:gosub schriftart
  308. 2720  text$="Bitte irgendeine Taste drücken !"
  309. 2730  xpos=150:ypos=340
  310. 2740  gosub textausgabe
  311. 2750  a$=chr$(inp(2))
  312. 2760  gosub normtext
  313. 2770  goto DIAGRAMM
  314. 2780  data 0,31,59,90,120,151,181,212,243,273,304,334,365
  315. 2800  data Sonntag,Montag,Dienstag,Mittwoch,Donnerstag,Freitag,Samstag
  316. 2801  '
  317. 2802  '---------------------------------> naechster Monat
  318. 2803  '
  319. 2900  WEITER:
  320. 2910  bismon=bismon+1
  321. 2920  if bismon=13 then bismon=1:bisjah=bisjah+1
  322. 2930  goto 1170
  323. 2997  '
  324. 2998  '---------------------------------> gem-routinen
  325. 2999  '
  326. 3100  FULLWIND:
  327. 3110  poke  gintin,3
  328. 3120  poke  gintin+2,5
  329. 3130  poke  gintin+4,0
  330. 3140  poke  gintin+6,1
  331. 3150  poke  gintin+8,658
  332. 3160  poke  gintin+10,417
  333. 3170  gemsys 105
  334. 3180  return
  335. 3190  '----------------------------------------
  336. 3200  CLEARDESK:
  337. 3210  color 1,0,1 :
  338. 3220  xpos1=-1:xpos2=638:ypos1=-40:ypos2=-20
  339. 3230  gosub rechteck:color 1,1,1
  340. 3240  return
  341. 3250  '-------------------------------------
  342. 3260  SCHRUMPFBOX:
  343. 3270  schrumpf% = 1
  344. 3280  GROWBOX:
  345. 3290  poke control+2,8
  346. 3300  poke control+4,1
  347. 3310  poke gintin,   xalt
  348. 3320  poke gintin+2, yalt
  349. 3330  poke gintin+4, breit1
  350. 3340  poke gintin+6, hoch1
  351. 3350  poke gintin+8, xneu +1
  352. 3360  poke gintin+10,yneu +38
  353. 3370  poke gintin+12,breit2
  354. 3380  poke gintin+14,hoch2
  355. 3390  gemsys 73 + schrumpf%
  356. 3400  schrumpf% = 0
  357. 3410  return
  358. 3420  '---------------------------------
  359. 3440  INIT:
  360. 3450  aes#=gb
  361. 3460  control=peek(aes#)
  362. 3470  global =peek(aes#+4)
  363. 3480  gintin =peek(aes#+8)
  364. 3490  gintout=peek(aes#+12)
  365. 3500  addrin =peek(aes#+16)
  366. 3510  addrout=peek(aes#+20)
  367. 3520  return
  368. 3530  '--------------------
  369. 3540  RECHTECK:
  370. 3550  POKE CONTRL   ,11
  371. 3560  POKE CONTRL+2 ,2
  372. 3570  POKE CONTRL+6 ,0
  373. 3580  POKE CONTRL+10,1
  374. 3590  POKE PTSIN  ,XPOS1 +1
  375. 3600  POKE PTSIN+2,YPOS1 +38
  376. 3610  POKE PTSIN+4,XPOS2 +1
  377. 3620  POKE PTSIN+6,YPOS2 +38
  378. 3630  VDISYS
  379. 3640  RETURN
  380. 3650  '-----------------------------------
  381. 3660  RECHTECKRUND:
  382. 3670  POKE CONTRL   ,11
  383. 3680  POKE CONTRL+2 ,2
  384. 3690  POKE CONTRL+6 ,0
  385. 3700  IF FUELL=0 THEN POKE CONTRL+10,8 ELSE POKE CONTRL+10,9
  386. 3710  POKE PTSIN  ,XPOS1 +1
  387. 3720  POKE PTSIN+2,YPOS1 +38
  388. 3730  POKE PTSIN+4,XPOS2 +1
  389. 3740  POKE PTSIN+6,YPOS2 +38
  390. 3750  VDISYS
  391. 3760  RETURN
  392. 3770  '-----------------------------------
  393. 3780  LINIENENDFORM:
  394. 3790  POKE CONTRL   ,108
  395. 3800  POKE CONTRL+2 ,1
  396. 3810  POKE CONTRL+6 ,0
  397. 3820  POKE INTIN, ANFANGSFORM
  398. 3830  POKE INTIN+2, ENDFORM
  399. 3840  VDISYS
  400. 3850  RETURN
  401. 3860  '-----------------------------------
  402. 3870  SCHRIFTART:
  403. 3880  poke contrl  ,106
  404. 3890  poke contrl+2,0
  405. 3900  poke contrl+6,1
  406. 3910  poke intin ,schrifttyp
  407. 3920  vdisys
  408. 3930  return
  409. 3940  '---------------------------------------------
  410. 3950  SCHRIFTGROESSE:
  411. 3960  poke contrl  ,107
  412. 3970  poke contrl+2,0
  413. 3980  poke contrl+6,1
  414. 3990  poke intin ,groesse
  415. 4000  vdisys
  416. 4010  return
  417. 4020  '---------------------------------------------
  418. 4030  TEXTAUSGABE:
  419. 4040  for i=0 to len(text$)-1
  420. 4050  poke intin+i*2,asc(mid$(text$,i+1,1))
  421. 4060  next
  422. 4070  poke intin+i*2,0
  423. 4080  poke contrl,8
  424. 4090  poke contrl+2,1
  425. 4100  poke contrl+6,len(text$)+1
  426. 4110  poke ptsin , xpos+1
  427. 4120  poke ptsin+2,ypos+38
  428. 4130  vdisys
  429. 4140  return
  430. 4150  '---------------------------------------------
  431. 4160  GRAFIKMODUS:
  432. 4170  poke contrl,32
  433. 4180  poke contrl+2,0
  434. 4190  poke contrl+6,1
  435. 4200  poke intin,modus
  436. 4210  vdisys
  437. 4220  return
  438. 4230  '-------------------------------
  439. 4240  POLYLINE:
  440. 4250  poke contrl,6
  441. 4260  poke contrl+6,0
  442. 4270  poke contrl+2,anzahl
  443. 4280  for i = 0 to anzahl
  444. 4290  poke ptsin + i*4,xkoord(i)+1
  445. 4300  poke ptsin + 2+i*4,ykoord(i)+38
  446. 4310  next
  447. 4320  vdisys
  448. 4330  return
  449. 4340  '-------------------------------
  450. 4350  NORMTEXT:
  451. 4360  schrifttyp=0:gosub schriftart
  452. 4370  groesse=10  :gosub schriftgroesse
  453. 4380  modus=1:gosub grafikmodus
  454. 4390  return
  455. 4399  '
  456. 4410  '------------------------------> input
  457. 4411  '
  458. 4420  INPUTFORM:
  459. 4430  if groesse < 9 then space = 6
  460. 4440  if groesse = 9 then space = 8
  461. 4450  if groesse > 8 and groesse < 16 then space = 8
  462. 4460  if groesse > 15 and groesse < 18 then space = 12
  463. 4470  if groesse > 17 then space = 16
  464. 4480  gosub SCHRIFTGROESSE
  465. 4490  key$=""
  466. 4500  text$(1)="0123456789"
  467. 4510  text$(2)=text$(1)+"."
  468. 4520  text$(3)=" abcdefghijklmnopqrstuvwxyzäöüABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜß"
  469. 4530  text$(4)=text$(1)+text$(3)
  470. 4540  text$(5)=text$(4)+"<>,;.:-_!§$%&/()=?`'^#*+@\[]{}~|"+chr$(34)
  471. 4550  text$(6)="jJnN"
  472. 4560  text$(7)="KANN NOCH FREI BELEGT WERDEN !"
  473. 4570  text$(8)="KANN NOCH FREI BELEGT WERDEN !"
  474. 4580  if modus <> 0 then text$(0) = text$(modus)
  475. 4590  text$=chr$(4):gosub textausgabe
  476. 4600  if laenge=0 and len(key$)=1 then gosub normtext:return
  477. 4610  key=inp(2)
  478. 4620  if key=8or key=127 then 4670
  479. 4630  if key = 13 then text$=" ":gosub textausgabe:gosub normtext:return
  480. 4640  if len(key$) = laenge and len(key$) >0 then out 2,7 : goto 4600
  481. 4650  if modus<9then if instr(0,text$(0),chr$(key))=0then out 2,7:goto 4600
  482. 4660  key$=key$+chr$(key):text$=chr$(key)+chr$(4):gosub textausgabe:xpos=xpos+space:goto 4600
  483. 4670  '********** Fehlerauswertung **************************
  484. 4680  if len(key$)=0 then out 2,7 : goto 4600
  485. 4690  key$=left$(key$,len(key$)-1)
  486. 4700  xpos=xpos-space : text$=chr$(4)+" " : gosub textausgabe
  487. 4710  goto 4600
  488. 4720  '********************************************************
  489. 9998  '
  490. 9999  '---------------------------------> falsches datum
  491. 10000 '
  492. 10015 modus=4:gosub grafikmodus
  493. 10020 xpos=270:ypos=138:text$="FALSCHES DATUM !!":gosub textausgabe
  494. 10025 out 2,7:out 2,7
  495. 10030 for w=1 to 2000: next w
  496. 10035 gosub normtext
  497. 10040 xpos=270:ypos=138:text$="                 ":gosub textausgabe
  498. 10050 goto 860
  499. 11010 modus=4:gosub grafikmodus
  500. 11020 xpos=250:ypos=200:text$="FALSCHES DATUM !!":gosub textausgabe
  501. 11025 out 2,7:out 2,7
  502. 11030 for w=1 to 2000: next w
  503. 11035 gosub normtext
  504. 11040 xpos=250:ypos=200:text$="                 ":gosub textausgabe
  505. 11050 goto 1080
  506. ə